replace_matrix <- function(m, b, missing = NA) {
    m <- m * b
    is.na(m) <- m <= 0

    m
}

#' Generate offsets for two groups of coders
#'
#' Given a matrix of ratings in the wide format (each column is a
#' separate coder and each row is a separate country-date),
#' \code{offset_diff} generates offsets for those coders specified in
#' the logical matrix \code{target} by weighted mean difference.
#'
#' @param m A matrix in the V-Dem wide format.
#' @param target Logical matrix denoting target coder group.
#' @param weight Numeric matrix for weighted row means (typically
#'     coder submitted confidences).
#' @param min Minimum number of coders country-date (\emph{i.e.}, rows) for the
#'     non-target coders.
#'
#' @details This function is exclusively used to generate offset
#'     priors for the historical and "new" coders (\emph{i.e.}, those
#'     who've only coded 2005 - present). The offsets are generated by
#'     comparing the ratings of one of the aforementioned groups to
#'     the coders not flagged by the logical \code{target} matrix.
#'
#'     The \code{min} argument allows us to restrict the calculation
#'     of weighted mean difference to only those country-dates
#'     (\emph{i.e.}, rows) where we have at least some minimum numbers
#'     of non-target coders.
#'
#' @return Single numeric value that can be used to offset the ratings
#'     for all of the target coders.
#'
#' @examples
#' # Matrix of raw coder-level data with 3 coders where coder "a" will
#' # be our historical coder.
#' m <- matrix(1:9, 3, 3,
#'             dimnames = list(c("AFG 1899-01-01",
#'                               "AFG 1900-01-01",
#'                               "AFG 1901-01-01"),
#'                             letters[1:3]))
#'
#' # Logical matrix for our single historical coder
#' historical <- matrix(c(rep(TRUE, 3), rep(FALSE, 6)), 3, 3)
#'
#' # Confidences, for this example everyone is 100% confident
#' conf <- matrix(rep(1, 9), 3, 3)
#'
#' # Generate offsets for our single historical coder
#' offset_diff(m, historical, conf)
#'
#' @family prior functions
#'
#' @export
offset_diff <- function(m, target, weight, min = 1) {
    if (!all_identical(dim(m), dim(target), dim(weight)))
        stop("Invalid dimensions", call. = F)

    if (all(!target))
        return(0)

    old_coders <- replace_matrix(m, !target)
    offset_coders <- replace_matrix(m, target)

    old_coders[colSums(apply(old_coders, 1, function(x) !is.na(x))) < min, ] <- NA

    old_means <- weighted.rowMeans(old_coders, weight)
    offset_means <- weighted.rowMeans(offset_coders, weight)

    if (all(is.nan(old_means) | is.nan(offset_means)))
        return(0)

    mean(old_means - offset_means, na.rm = T)
}

#' Weighted Row Means
#'
#' Calculates the weighted row means for a complex, numeric, integer,
#' or logical matrix.
#'
#' @param x Matrix to be summarised rowwise by the weighted
#'     mean.
#' @param y Matrix of the same dimensions as x. Used as the
#'     weights for calculating the weighted mean of \code{x}.
#' @param na.rm Logical. Whether missing values should be removed.
#'
#' @return NumericVector the same length as \code{nrow(x)}.
#'
#' @seealso \code{\link{rowMeans}}
#' @family prior functions
#'
#' @export
weighted.rowMeans <- function(x, y, na.rm = T) UseMethod("weighted.rowMeans")

weighted.rowMeans.matrix <- function(x, y, na.rm = T) {
    y[is.na(x)] <- NA

    rowSums(x * y, na.rm = na.rm) / rowSums(y, na.rm = na.rm)
}

#' Convert keys to an unordered balanced sequence
#'
#' Given a vector of \code{keys}, \code{to_seq} will return a
#' balanced sequence of numeric values from \code{min} to
#' \code{max}. The values will correspond to the unique alphabetical
#' ordering of \code{keys} applied to the original ordering of
#' \code{keys}.
#'
#' @param keys A vector of any type.
#' @param min Start value for the output sequence
#' @param max End value for the output sequence
#'
#' @details This function is used exclusively to set the priors for
#'     the vignettes. Currently, based on the order of the thresholds,
#'     we set the priors to be from -1.5 to 1.5.
#'
#'     Vignette thresholds can be sorted by any identifier as long as
#'     we can determine the proper order using \code{sort}.
#'
#' @examples
#' to_seq(c("a", "d", "c", "a"))
#'
#' @family prior functions
#'
#' @export
to_seq <- function(keys, min = -1.5, max = 1.5) {
    unique_keys <- sort(unique(keys))
    p <- seq(min, max, length.out = length(unique_keys))
    names(p) <- unique_keys

    stats::setNames(p[match(keys, unique_keys)], NULL)
}
